Last updated: 2020-04-26

Checks: 6 1

Knit directory: tracking-app/

This reproducible R Markdown analysis was created with workflowr (version 1.6.1). The Checks tab describes the reproducibility checks that were applied when the results were created. The Past versions tab lists the development history.


The R Markdown file has unstaged changes. To know which version of the R Markdown file created these results, you’ll want to first commit it to the Git repo. If you’re still working on the analysis, you can ignore this warning. When you’re finished, you can run wflow_publish to commit the R Markdown file and build the HTML.

Great job! The global environment was empty. Objects defined in the global environment can affect the analysis in your R Markdown file in unknown ways. For reproduciblity it’s best to always run the code in an empty environment.

The command set.seed(20200329) was run prior to running the code in the R Markdown file. Setting a seed ensures that any results that rely on randomness, e.g. subsampling or permutations, are reproducible.

Great job! Recording the operating system, R version, and package versions is critical for reproducibility.

Nice! There were no cached chunks for this analysis, so you can be confident that you successfully produced the results during this run.

Great job! Using relative paths to the files within your workflowr project makes it easier to run your code on other machines.

Great! You are using Git for version control. Tracking code development and connecting the code version to the results is critical for reproducibility.

The results in this page were generated with repository version d38f555. See the Past versions tab to see a history of the changes made to the R Markdown and HTML files.

Note that you need to be careful to ensure that all relevant files for the analysis have been committed to Git prior to generating the results (you can use wflow_publish or wflow_git_commit). workflowr only checks the R Markdown file, but you know if there are other scripts or data files that it depends on. Below is the status of the Git repository when the results were generated:


Untracked files:
    Untracked:  .Rhistory

Unstaged changes:
    Modified:   .DS_Store
    Modified:   analysis/.Rhistory
    Modified:   analysis/GERcovWave2.Rmd

Note that any generated files, e.g. HTML, png, CSS, etc., are not included in this status report because it is ok for generated content to have uncommitted changes.


These are the previous versions of the repository in which changes were made to the R Markdown (analysis/GERcovWave2.Rmd) and HTML (public/GERcovWave2.html) files. If you’ve configured a remote Git repository (see ?wflow_git_remote), click on the hyperlinks in the table below to view the files as they were in that past version.

File Version Author Date Message
Rmd d38f555 Lorenz-Spreen 2020-04-26 added home link
html d38f555 Lorenz-Spreen 2020-04-26 added home link
Rmd 639c02b Lorenz-Spreen 2020-04-26 analysis of second wave
html 639c02b Lorenz-Spreen 2020-04-26 analysis of second wave

1 Status of this report

These results represent a snapshot of an ongoing analysis and have not been peer-reviewed. They are for information but not for citation or to inform policy (as yet). Please report comments or bugs to or leave a comment on the relevant post on our subreddit.

Last update: Sun Apr 26 23:42:31 2020

These results are for Germany, and are from a second wave of the stury, find results from the first wave here. For other countries, return Home and choose another country.

In addition to the two scenarios (mild and severe) included in the first wave, this wave also included a Bluetooth scenario. The Bluetooth scenario was as follows:

Tracking COVID-19 Transmission

The COVID-19 pandemic has rapidly become a worldwide threat. Containing the virus’ spread is essential to minimise the impact on the healthcare system, the economy, and save many lives. Apple and Google have proposed adding a contact tracing capability to existing smartphones to help inform people if they have been exposed to others with COVID-19. This would help reduce community spread of COVID-19 by allowing people to voluntarily self-isolate. When two people are near each other, their phones would connect via bluetooth. If a person is later identified as being infected, the people they have been in close proximity to are then notified without the government knowing who they are. The use of this contact tracing capability would be completely voluntary. People who are notified would not be informed who had tested positive.

Participants: A representative samples of 1,500 German participants were recruited on 17 April 2020. through the online platform Lucid. Participants were at least 18 years old.

Preregistration: The preregistration for the first wave of this study is here.

2 Basic exploration

Note that the R code for this analysis can be hidden or made visible by clicking the black toggles next to each segment.

# Reading data and variable names 
covfn        <- paste("data/German_tracking_survey_numeric_wave2.csv",sep="/") #this is the complete data file with demographics (but no location and IP). Version on OSF does not have demographics to reduce likelihood of reidentification of respondents.
covdata      <- read_csv(covfn)
Parsed with column specification:
cols(
  .default = col_double(),
  StartDate = col_datetime(format = ""),
  EndDate = col_datetime(format = ""),
  RecordedDate = col_datetime(format = ""),
  ResponseId = col_character(),
  DistributionChannel = col_character(),
  UserLanguage = col_character(),
  Q_RecaptchaScore = col_logical(),
  Q_RelevantIDDuplicate = col_logical(),
  Q_RelevantIDDuplicateScore = col_logical(),
  Q_RelevantIDFraudScore = col_logical(),
  COVID_info_source = col_number(),
  free_text = col_character(),
  rid = col_character(),
  scenario_type = col_character()
)
See spec(...) for full column specifications.
#fix annoying misspelling of variables
covdata %<>% rename(age_1 = age_4)
#read the duplicate records previously computed from the raw data set
#duplicaterecs <- read.table("data/dupsUK2.dat")

2.1 Clean up data

  • Remove duplicate observations identified in a prior, private analysis.
  • Remove observations that are returned as not having finished.
  • Remove observations with a Status other than 0 (e.g., previews or suspected spam responses).
  • Remove observations from participants who answered the fact check about the scenario incorrectly.
  • Remove lots of unnecessary variables to create a lean dataset.
  • Reverse score item wv_freemarket_lim so it points towards increasing libertarianism, just like the other two worldview items.
#remove unfinished, failed attention check, wrongly directed
covfin  <- covdata %>% filter(Finished==1) %>%  filter(attention_check == 1 | att_check_bt == 1) %>% select(-c(starts_with("Recipient"),starts_with("Q_"),Status,Finished,Progress,DistributionChannel,UserLanguage,ResponseId))


#create good labels for variables (from expss package)
covfin <- apply_labels(covfin,
                       gender = "Gender",
                       gender = c("Male" = 1, "Female" = 2, "Other" = 3),
                       education = "Education",
                       education = c("Hauptschule" = 1, "Realschule" = 2, "Abitur" = 3, "Universitaet" = 5, "None" = 4),
                       COVID_pos = "I was tested positive",
                       COVID_pos = c("Yes" = 1, "No" = 0),
                       COVID_pos_others = "Tested pos someone I know",
                       COVID_pos_others = c("Yes" = 1, "No" = 0),
                       COVID_comply_pers = "Personal compliance",
                       COVID_comply_pers =  c("I don't follow these policies at all" = 1, 
                                              "I mostly don't follow these policies"= 2, 
                                              "I follow these policies somewhat" = 3, 
                                              "I mostly follow these policies, but not all the way" = 4, 
                                              "I completely follow these policies" = 5, 
                                              "I go slightly beyond what the government policy mandates" = 6,
                                              "I go somewhat beyond what the government policy mandates" = 7, 
                                              "I go significantly beyond what the government policy mandates" = 8,
                                              "I am in complete quarantine and never leave my home" = 9),
                                              mobileuse_sev = "Use mobile",
                       mobileuse_sev = c("Yes" = 1, "No" = 0),
                       smartphoneuse_mildbt = "Use smartphone",
                       smartphoneuse_mildbt = c("Yes" = 1, "No" = 0),
                       scenario_type = "Type of policy scenario",
                       COVID_lost_job = "I lost my job",
                       COVID_lost_job = c("Yes" = 1, "No" = 0))
                       
covfin$COVID_info_source <- gsub("1", "Newspaper (printed or online)", covfin$COVID_info_source)
covfin$COVID_info_source <- gsub("2", "Social media", covfin$COVID_info_source)
covfin$COVID_info_source <- gsub("3", "Friends/family", covfin$COVID_info_source)
covfin$COVID_info_source <- gsub("4", "Radio", covfin$COVID_info_source)
covfin$COVID_info_source <- gsub("5", "Television", covfin$COVID_info_source)
covfin$COVID_info_source <- gsub("6", "Other", covfin$COVID_info_source)
covfin <- apply_labels(covfin, COVID_info_source= "Information source")
#labels for country-specific variables

#reverse score
#covfin <- covfin %>% mutate(wv_freemarket_lim=revscore(wv_freemarket_lim,7))
#compute composite score for worldview
covfin$Worldview <- covfin %>% select(starts_with("wv_")) %>% apply(.,1, mean, na.rm=TRUE)

2.2 Demographics

Number of retained participants: 1109.


Gender, education, and age:

cro_tpct(covfin$gender) %>% set_caption("Gender identification: Percentages")
Gender identification: Percentages
 #Total 
 Gender 
   Male  49.3
   Female  50.2
   Other  0.5
   #Total cases  1109
cro_tpct(covfin$education) %>% set_caption("Level of education: Percentages")
Level of education: Percentages
 #Total 
 Education 
   Hauptschule  13.1
   Realschule  35.3
   Abitur  27.8
   None  0.7
   Universitaet  23.2
   #Total cases  1109
descr(covfin$age_1)
Descriptive Statistics  
covfin$age_1  
N: 1109  

                      age_1
----------------- ---------
             Mean     46.51
          Std.Dev     16.07
              Min     18.00
               Q1     33.00
           Median     48.00
               Q3     59.00
              Max     88.00
              MAD     19.27
              IQR     26.00
               CV      0.35
         Skewness     -0.09
      SE.Skewness      0.07
         Kurtosis     -1.04
          N.Valid   1109.00
        Pct.Valid    100.00
hist(covfin$age_1, xlab="Age",main="",las=1)

Version Author Date
639c02b Lorenz-Spreen 2020-04-26

Phone ownership:

cro_tpct(covfin$smartphoneuse_mildbt) %>% set_caption("I use a smartphone: Percentages")
I use a smartphone: Percentages
 #Total 
 Use smartphone 
   No  4.1
   Yes  95.9
   #Total cases  702
cro_tpct(covfin$mobileuse_sev) %>% set_caption("I use a mobile phone: Percentages")
I use a mobile phone: Percentages
 #Total 
 Use mobile 
   No  2.7
   Yes  97.3
   #Total cases  407

2.3 COVID impact on participant

How long have you been in “lockdown”?

hist(covfin$COVID_ndays_lockdown_4, xlab="Days in `lockdown`",main="",las=1)

Version Author Date
639c02b Lorenz-Spreen 2020-04-26

Have you, temporarily or permanently, lost your job as a consequence of the novel coronavirus (COVID-19) pandemic?

cro_tpct(covfin$COVID_lost_job) %>% set_caption("I have lost my job: Percentages")
I have lost my job: Percentages
 #Total 
 I lost my job 
   No  86.2
   Yes  13.8
   #Total cases  1109

What is your main source of information about the novel coronavirus (COVID-19) pandemic?

cro_tpct(covfin$COVID_info_source) %>% set_caption("Information source: Percentages")
Information source: Percentages
 #Total 
 Information source 
   Friends/family  0.8
   Friends/familyRadio  0.1
   Friends/familyRadioOther  0.1
   Friends/familyRadioTelevision  2.3
   Friends/familyRadioTelevisionOther  0.1
   Friends/familyTelevision  2.3
   Friends/familyTelevisionOther  0.4
   Newspaper (printed or online)  2.8
   Newspaper (printed or online)Friends/familyOther  0.1
   Newspaper (printed or online)Friends/familyRadio  0.5
   Newspaper (printed or online)Friends/familyRadioOther  0.1
   Newspaper (printed or online)Friends/familyRadioTelevision  6.7
   Newspaper (printed or online)Friends/familyRadioTelevisionOther  0.5
   Newspaper (printed or online)Friends/familyTelevision  2.2
   Newspaper (printed or online)Friends/familyTelevisionOther  0.4
   Newspaper (printed or online)Other  0.2
   Newspaper (printed or online)Radio  0.8
   Newspaper (printed or online)RadioTelevision  9.6
   Newspaper (printed or online)RadioTelevisionOther  0.8
   Newspaper (printed or online)Social media  1.2
   Newspaper (printed or online)Social mediaFriends/family  1.1
   Newspaper (printed or online)Social mediaFriends/familyRadio  0.4
   Newspaper (printed or online)Social mediaFriends/familyRadioTelevision  8.3
   Newspaper (printed or online)Social mediaFriends/familyRadioTelevisionOther  0.5
   Newspaper (printed or online)Social mediaFriends/familyTelevision  3.8
   Newspaper (printed or online)Social mediaFriends/familyTelevisionOther  0.3
   Newspaper (printed or online)Social mediaRadio  0.4
   Newspaper (printed or online)Social mediaRadioTelevision  3.5
   Newspaper (printed or online)Social mediaRadioTelevisionOther  0.1
   Newspaper (printed or online)Social mediaTelevision  3.1
   Newspaper (printed or online)Social mediaTelevisionOther  0.1
   Newspaper (printed or online)Television  8.7
   Newspaper (printed or online)TelevisionOther  0.7
   Other  1.7
   Radio  1.1
   RadioOther  0.1
   RadioTelevision  4.8
   RadioTelevisionOther  0.5
   Social media  4.5
   Social mediaFriends/family  1.4
   Social mediaFriends/familyOther  0.1
   Social mediaFriends/familyRadio  0.4
   Social mediaFriends/familyRadioTelevision  2.6
   Social mediaFriends/familyRadioTelevisionOther  0.2
   Social mediaFriends/familyTelevision  2.5
   Social mediaFriends/familyTelevisionOther  0.5
   Social mediaOther  0.5
   Social mediaRadio  0.9
   Social mediaRadioTelevision  2.6
   Social mediaRadioTelevisionOther  0.1
   Social mediaTelevision  3.8
   Social mediaTelevisionOther  0.4
   Television  8.5
   TelevisionOther  0.5
   #Total cases  1109

Have you tested positive for COVID?

cro_tpct(covfin$COVID_pos) %>% set_caption("I tested positive for COVID-19: Percentages")                       
I tested positive for COVID-19: Percentages
 #Total 
 I was tested positive 
   No  97.7
   Yes  2.3
   #Total cases  1109

Has someone you know tested positive for COVID?

cro_tpct(covfin$COVID_pos_others) %>% set_caption("Somebody I know tested positive for COVID-19: Percentages")                       
Somebody I know tested positive for COVID-19: Percentages
 #Total 
 Tested pos someone I know 
   No  80.5
   Yes  19.5
   #Total cases  1109

What percentage of the population do you think is complying with government policies regarding social distancing?

hist(covfin$COVID_comply_percent,las=1,xlab="Estimated compliance of population (%)",main="")

Version Author Date
639c02b Lorenz-Spreen 2020-04-26

How much are you following government policies regarding social distancing?

cro_tpct(covfin$COVID_comply_pers) %>% set_caption("Compliance with policy: Percentages")                       
Compliance with policy: Percentages
 #Total 
 Personal compliance 
   I don’t follow these policies at all  1.4
   I mostly don’t follow these policies  2.1
   I follow these policies somewhat  4.1
   I mostly follow these policies, but not all the way  26.8
   I completely follow these policies  46.6
   I go slightly beyond what the government policy mandates  5.9
   I go somewhat beyond what the government policy mandates  5.4
   I go significantly beyond what the government policy mandates  6.0
   I am in complete quarantine and never leave my home  1.8
   #Total cases  1109

2.4 COVID risk perception

Estimated fatalities in various countries:

vioplot (covfin %>% select(contains("fatal")), horizontal = TRUE, 
         xlab="Estimated fatalities",yaxt="n")
axis(side=2,at=1:9,labels=c("AUS", "China", "GER", "Italy", "S'pore", "S Korea", "Spain", "U.S.A.", "U.K."),las=1)
axis(side=1,at=seq(0,50000,10000))

Version Author Date
639c02b Lorenz-Spreen 2020-04-26

There are 4 items probing people’s COVID risk perception:

  • How severe do you think novel coronavirus (COVID-19) will be in the population as a whole?
  • How harmful would it be for your health if you were to become infected with COVID-19?
  • How concerned are you that you might become infected with COVID-19?
  • How concerned are you that somebody you know might become infected with novel?

Provide snapshot of responses and correlations between items.

covvars<-gather(covfin %>% select(c(COVID_sev_general,COVID_pers_harm,COVID_pers_concern,COVID_concern4others)),factor_key = TRUE)
covvars$key <- factor(covvars$key,labels=c("Severity for population","Harm to my health if infected","Concern I will be infected","Concern that someone I know infected"))
covhisto <- ggplot(covvars, aes(value)) +
  geom_histogram(bins = 10) +
  xlab("Response") + ylab("Frequency") +
  facet_wrap(~key, scales = 'free_x',labeller=label_value)
print(covhisto)
Warning: Removed 50 rows containing non-finite values (stat_bin).

Version Author Date
639c02b Lorenz-Spreen 2020-04-26
covfin %>% select(c(COVID_sev_general,COVID_pers_harm,COVID_pers_concern,COVID_concern4others)) %>% cor (.,use="pairwise.complete.obs") %>% round(.,3)
                     COVID_sev_general COVID_pers_harm COVID_pers_concern
COVID_sev_general                1.000           0.377              0.521
COVID_pers_harm                  0.377           1.000              0.639
COVID_pers_concern               0.521           0.639              1.000
COVID_concern4others             0.488           0.392              0.675
                     COVID_concern4others
COVID_sev_general                   0.488
COVID_pers_harm                     0.392
COVID_pers_concern                  0.675
COVID_concern4others                1.000
#compute composite score for COVID risk
covfin$COVIDrisk <- covfin %>% select(c(COVID_sev_general,COVID_pers_harm,COVID_pers_concern,COVID_concern4others)) %>% apply(.,1, mean, na.rm=TRUE)
#compute composite score for government trust
covfin$govtrust <- covfin %>% select(starts_with("trus")) %>% apply(.,1, mean, na.rm=TRUE)

3 Comparison between scenarios

3.1 Efficacy of policy

Not all items are entirely commensurate between scenarios. We begin with a graphical summary.

The figure below shows people’s confidence that each of the scenarios would reduce their likelihood of contracting COVID-19:

plotvio (covfin, c("reduce_lik_bt", "reduce_lik_mild","reduce_lik_sev" ), "blue", "Reduce contracting")

Version Author Date
639c02b Lorenz-Spreen 2020-04-26

The figure below shows people’s confidence that each of the scenarios would allow them to resume their normal lives more rapidly

plotvio (covfin, c("return_activ_bt", "return_activ_mild", "return_activ_sev"), "green", "Resume normal")

Version Author Date
639c02b Lorenz-Spreen 2020-04-26

The figure below shows people’s confidence that each of the scenarios would reduce spread of COVID-19 in the community.

plotvio (covfin, c("reduce_spread_bt", "reduce_spread_mild", "reduce_spread_severe"), "orange", "Reduce spread")

Version Author Date
639c02b Lorenz-Spreen 2020-04-26

3.2 Acceptability of policy

Basic acceptability of each scenario, probed by a single item immediately after reading the scenario. The table shows percentages. For the mild and Bluetooth scenarios, the question refers to whether participant would download the app. For the severe scenario, the question refers to acceptability of the tracking mandated by government.

#use gather and drop
accept1 <- covfin %>% select(c(app_uptake1, is_accceptable1, bluetooth_uptake1_bt)) %>% 
                    pivot_longer(c(app_uptake1,is_accceptable1,bluetooth_uptake1_bt), 
                                names_to = "key", values_to = "value")
covfin$accept1 <- (accept1 %>% drop_na())$value
#we do not drop NAs for the pivoted data frame to allow correct merging with the conditional responses below for quasi interval score
accept1 <- apply_labels(accept1,
                        value = "Acceptability of policy",
                        value = c("Yes" = 1, "No" = 0),
                        key = "Type of scenario",
                        key = c("Mild" ="app_uptake1", "Severe" = "is_accceptable1", "Bluetooth" = "bluetooth_uptake1_bt"))
cro_tpct(accept1$value,row_vars=accept1$key) #presence of NAs makes no difference here
 #Total 
 Type of scenario 
   Bluetooth   Acceptability of policy   No  38.5
    Yes  61.5
    #Total cases  340
   Mild   Acceptability of policy   No  35.6
    Yes  64.4
    #Total cases  362
   Severe   Acceptability of policy   No  40.0
    Yes  60.0
    #Total cases  407
chisq.test(unlabel(accept1$value),unlabel(accept1$key),correct=TRUE)

    Pearson's Chi-squared test

data:  unlabel(accept1$value) and unlabel(accept1$key)
X-squared = 1.6131, df = 2, p-value = 0.4464

The difference between acceptability of scenarios is not significant by a \(\chi^2\) test on the contingency table.


Repeated probing of basic acceptability of each scenario after multiple questions about the scenario have been answered. The table shows percentages. For the mild and Bluetooth scenarios, the question refers to whether participant would download the app. For the severe scenario, the question refers to acceptability of the tracking mandated by government.

accept2 <- covfin %>% select(c(app_uptake2,is_acceptable2,bluetooth_uptake2_bt)) %>%  
                      pivot_longer(c(app_uptake2,is_acceptable2,bluetooth_uptake2_bt), 
                                   names_to = "key", values_to = "value")
accept2 <- apply_labels(accept2,
                        value = "Acceptability of policy",
                        value = c("Yes" = 1, "No" = 0),
                        key = "Type of scenario",
                        key = c("Mild" ="app_uptake2", "Severe" = "is_acceptable2", "Bluetooth" = "bluetooth_uptake2_bt"))
cro_tpct(accept2$value,row_vars=accept2$key)
 #Total 
 Type of scenario 
   Bluetooth   Acceptability of policy   No  41.2
    Yes  58.8
    #Total cases  340
   Mild   Acceptability of policy   No  35.7
    Yes  64.3
    #Total cases  361
   Severe   Acceptability of policy   No  44.9
    Yes  55.1
    #Total cases  405
chisq.test(unlabel(accept2$value),unlabel(accept2$key),correct=TRUE)

    Pearson's Chi-squared test

data:  unlabel(accept2$value) and unlabel(accept2$key)
X-squared = 6.7281, df = 2, p-value = 0.0346

The difference between acceptability of scenarios is this time significant by a \(\chi^2\) test, and overall acceptability of all scenarios has been reduced slightly compared to first set of questions.


Those people who found the scenario unacceptable were asked follow-up questions. For all scenarios, people were asked if their decision would change if the government was required to delete the data and cease tracking after 6 months. Responses to this sunset question (percentages) were as follows:

change_sunset <- covfin %>% select(c(sunset_app,sunset,change_sunset_bt)) %>%
                           pivot_longer(c(sunset_app,sunset,change_sunset_bt), 
                                        names_to = "key", values_to = "value")
change_sunset <- apply_labels(change_sunset,
                                  value = "Acceptability with sunset",
                                  value = c("Yes" = 1, "No" = 0),
                                  key = "Type of scenario",
                                  key = c("Mild" ="sunset_app", "Severe" = "sunset", "Bluetooth" = "change_sunset_bt"))
cro_tpct(change_sunset$value,row_vars=change_sunset$key)
 #Total 
 Type of scenario 
   Bluetooth   Acceptability with sunset   No  80.0
    Yes  20.0
    #Total cases  140
   Mild   Acceptability with sunset   No  79.1
    Yes  20.9
    #Total cases  129
   Severe   Acceptability with sunset   No  68.7
    Yes  31.3
    #Total cases  182
chisq.test(unlabel(change_sunset$value),unlabel(change_sunset$key),correct=TRUE)

    Pearson's Chi-squared test

data:  unlabel(change_sunset$value) and unlabel(change_sunset$key)
X-squared = 6.9057, df = 2, p-value = 0.03165

The majority of people persisted in their opposition to the policy even with a sunset clause, although this differed significantly between scenarios.


In addition, people who found the mild scenario unacceptable where asked a further followup question, namely if they would change their decision if data was stored only on the user’s smartphone (not government servers) and people were given the option to provide the data if they tested positive.

covfin <- apply_labels(covfin,
                       data_local = "Acceptability with local storage",
                       data_local = c("Yes" = 1, "No" = 0))
cro_tpct(covfin$data_local)
 #Total 
 Acceptability with local storage 
   No  58.1
   Yes  41.9
   #Total cases  129

A little less than half of the people who rejected the policy initially were prepared to accept it with local data storage.


In addition, people who found the severe scenario unacceptable were asked a further followup question, namely if they would change their decision if there was an option to opt out of data collection.

covfin <- apply_labels(covfin,
                       opt_out = "Acceptability with opt-out",
                       opt_out = c("Yes" = 1, "No" = 0))
cro_tpct(covfin$opt_out)
 #Total 
 Acceptability with opt-out 
   No  42.9
   Yes  57.1
   #Total cases  182

A little more than half of the people who rejected the policy initially were prepared to accept it with an opt-out clause.

3.3 Assessment of risk of scenarios, trust in government / Apple and Google and data security

How difficult is it for people to decline participation in the proposed project? (1 = Extremely easy – 7 = Extremely difficult)

  covfin$decline_participate[covfin$scenario_type=="bluetooth"] <- covfin$decline_part_bt[covfin$scenario_type=="bluetooth"]
  vioplot(decline_participate ~ scenario_type, data=covfin, col = "lightgray", ylab="Decline", xlab="Condition", las=1, )

Version Author Date
639c02b Lorenz-Spreen 2020-04-26

To what extent is the Government only collecting the data necessary? (1 = Not at all – 7 = Completely)

  covfin$proportionality[covfin$scenario_type=="bluetooth"] <- covfin$proportionality_bt[covfin$scenario_type=="bluetooth"]
  vioplot(proportionality ~ scenario_type, data=covfin, col = "lightgray", ylab="Only data necessary", xlab="Condition", las=1, )

Version Author Date
639c02b Lorenz-Spreen 2020-04-26

How sensitive is the data being collected in the proposed project? (1 = Not at all – 7 = Extremely)

  covfin$sensitivity[covfin$scenario_type=="bluetooth"] <- covfin$Q399[covfin$scenario_type=="bluetooth"]
  vioplot(sensitivity ~ scenario_type, data=covfin, col = "lightgray", ylab="Sensitivity of data", xlab="Condition", las=1, )

Version Author Date
639c02b Lorenz-Spreen 2020-04-26

How serious is the risk of harm that could arise from the proposed project? (1 = Not at all – 7 = Extremely)

  covfin$risk_of_harm[covfin$scenario_type=="bluetooth"] <- covfin$risk_of_harm_bt[covfin$scenario_type=="bluetooth"]
  vioplot(risk_of_harm ~ scenario_type, data=covfin, col = "lightgray", ylab="Risk of harm", xlab="Condition", las=1, )

Version Author Date
639c02b Lorenz-Spreen 2020-04-26

How much do you trust the Government (or Apple and Google in the Bluetooth scenario) to use the tracking data only to deal with the COVID-19 pandemic? (1 = Not at all – 7 = Completely)

  covfin$trust_intentions[covfin$scenario_type=="bluetooth"] <- covfin$trust_intentions_bt[covfin$scenario_type=="bluetooth"]
  vioplot(trust_intentions ~ scenario_type, data=covfin, col = "lightgray", ylab="Trust intentions of government/corporations", xlab="Condition", las=1, )

Version Author Date
639c02b Lorenz-Spreen 2020-04-26

How much do you trust the Government (or Apple and Google in the Bluetooth scenario) to be able to ensure the privacy of each individual? (1 = Not at all – 7 = Completely)

  covfin$trust_respectprivacy[covfin$scenario_type=="bluetooth"] <- covfin$trust_respectpriv_bt[covfin$scenario_type=="bluetooth"]
  vioplot(trust_respectprivacy ~ scenario_type, data=covfin, col = "lightgray", ylab="Trust government/corporations preserve privacy", xlab="Condition", las=1, )

Version Author Date
639c02b Lorenz-Spreen 2020-04-26

How secure is the data that would be collected for the proposed project? (1 = Not at all – 7 = Completely)

  covfin$data_security[covfin$scenario_type=="bluetooth"] <- covfin$data_security_bt[covfin$scenario_type=="bluetooth"]
  vioplot(data_security ~ scenario_type, data=covfin, col = "lightgray", ylab="How secure is data", xlab="Condition", las=1, )

Version Author Date
639c02b Lorenz-Spreen 2020-04-26

To what extent do people have ongoing control of their data? (1 = No control at all – 7 = Complete control)

  vioplot(ongoing_control ~ scenario_type, data=covfin, col = "lightgray", ylab="Ongoing control over data", xlab="Condition", las=1, )

Version Author Date
639c02b Lorenz-Spreen 2020-04-26

4 Role of worldviews

4.1 Worldview and risk perception

We relate a composite of the 3 worldview items to the composite of the 4 items probing perceived risk from COVID. Worldview is scored such that greater values reflect greater libertarianism.

p <- ggplot(covfin, aes(Worldview, COVIDrisk)) +
  geom_point(size=1.5,shape = 21,fill="red",
             position=position_jitter(width=0.15, height=0.15)) +
  geom_smooth() +
  theme(plot.title = element_text(size = 18),
        panel.background = element_rect(fill = "white", colour = "grey50"),
        text = element_text(size=14)) +
  xlim(0.8,7.2) + ylim(0.8,5.2) +
  labs(x="Worldview (libertarianism)", y="Perceived COVID risk")
print(p)
`geom_smooth()` using method = 'gam' and formula 'y ~ s(x, bs = "cs")'
Warning: Removed 7 rows containing non-finite values (stat_smooth).
Warning: Removed 7 rows containing missing values (geom_point).

Version Author Date
639c02b Lorenz-Spreen 2020-04-26
pcor <- cor.test (covfin$Worldview,covfin$COVIDrisk, use="pairwise.complete.obs") %>% print()

    Pearson's product-moment correlation

data:  covfin$Worldview and covfin$COVIDrisk
t = 0.50249, df = 1100, p-value = 0.6154
alternative hypothesis: true correlation is not equal to 0
95 percent confidence interval:
 -0.04394351  0.07413594
sample estimates:
       cor 
0.01514903 

There is no evidence for an association between libertarianism and risk perception.

4.2 Worldviews and trust

We relate the composite of the 3 worldview items to the composite of the two trust-in-government items (which correlate 0.79 for severe and mild, and 0.788 for the Bluetooth scenario).

p <- ggplot(covfin, aes(Worldview, govtrust)) +
  geom_point(size=1.5,shape = 21,fill="red",
             position=position_jitter(width=0.15, height=0.15)) +
  geom_smooth() +
  theme(plot.title = element_text(size = 18),
        panel.background = element_rect(fill = "white", colour = "grey50"),
        text = element_text(size=14)) +
  xlim(0.8,7.2) + ylim(0.8,5.2) +
  labs(x="Worldview (libertarianism)", y="Trust in government")
print(p)
`geom_smooth()` using method = 'gam' and formula 'y ~ s(x, bs = "cs")'
Warning: Removed 121 rows containing non-finite values (stat_smooth).
Warning: Removed 121 rows containing missing values (geom_point).

Version Author Date
639c02b Lorenz-Spreen 2020-04-26
pcor <- cor.test (covfin$Worldview,covfin$govtrust, use="pairwise.complete.obs") %>% print()

    Pearson's product-moment correlation

data:  covfin$Worldview and covfin$govtrust
t = -0.26187, df = 1100, p-value = 0.7935
alternative hypothesis: true correlation is not equal to 0
95 percent confidence interval:
 -0.06691739  0.05118173
sample estimates:
         cor 
-0.007895361 

5 Immunity Passports

Participants were asked their views on “immunity passports”, explained as follows:

An ‘immunity passport’ indicates that you have had a disease and that you have the antibodies for the virus causing that disease. Having the antibodies implies that you are now immune and therefore unable to spread the virus to other people. Thus, if an antibody test indicates that you have had the disease, you could be allocated an ‘immunity passport’ which would subsequently allow you to move around freely. Immunity passports have been proposed as a potential step towards lifting movement restrictions during the COVID-19 pandemic.

5.1 Basic summary of immunity passport items

There were 7 items that queries attitudes towards immunity passports:

  • Would you support a government proposal to introduce ‘immunity passports’ for novel coronavirus (COVID-19)? (1 = Not at all – 6 = Fully)

  • How concerned are you about the idea of introducing an ‘immunity passport’ for novel coronavirus (COVID-19)? (1 = Not at all – 5 = Extremely)

  • How much would you like to be allocated an ‘immunity passport’ for novel coronavirus (COVID-19)? (1 = Not at all – 6 = Extremely)

  • To what extent do you believe an ‘immunity passport’ for novel coronavirus (COVID-19) could harm the social fabric of your country? (1 = Not at all – 6 = Extremely)

  • To what extent do you believe that it is fair for people with ‘immunity passports’ for novel coronavirus (COVID-19) to go back to work, while individuals without such an ‘immunity passport’ cannot? (Extremely unfair = 1 – Extemely fair = 5)

  • To what extent would you consider purposefully infecting yourself with novel coronavirus (COVID-19) to get an ‘immunity passport’ for novel coronavirus (COVID-19)? (1 = Not at all – 6 = Extremely)

  • Would you support a government proposal to introduce ‘immunity passports’ for novel coronavirus (COVID-19)? (1 = Not at all – 6 = Fully)

Summary statistics for the 7 items are:

ipcov <- covfin %>% select(starts_with("ip_"))

hist(ipcov)

Version Author Date
639c02b Lorenz-Spreen 2020-04-26
ipcov <- apply_labels(ipcov,ip_support2 = "Final support for Immunity Passports",
                            ip_support2 = c("Not at all" = 1, "Slightly" = 2, "A bit" = 3, 
                                            "Moderately" = 4, "A lot" = 5, "Fully" = 6))
cro_tpct(ipcov$ip_support2)
 #Total 
 Final support for Immunity Passports 
   Not at all  16.4
   Slightly  11.7
   A bit  19.9
   Moderately  19.6
   A lot  26.6
   Fully  5.9
   #Total cases  1103

Around 20% of participants reject the idea of immunity passports whereas more than 30% strongly or fully endorse it.


Two of the items (concern and fairness), are now reverse scored so everything is pointing in the same direction. Correlations among items are shown first, followed by graphs relating a composite immunity-passport-endorsement score to other variables. (Note: this is a crude composite score because scales with a different number of points are combined. This needs to be fixed.)

ipcov %<>% mutate(ip_concerned = revscore(ip_concerned,5), ip_harm_soc  = revscore(ip_harm_soc,6)) %>% select(-ip_infect_self)

cor(ipcov, use = "complete.obs")
             ip_support1 ip_concerned   ip_like ip_harm_soc   ip_fair
ip_support1    1.0000000    0.5676184 0.7671171   0.4939394 0.5395784
ip_concerned   0.5676184    1.0000000 0.4618850   0.6536050 0.3298029
ip_like        0.7671171    0.4618850 1.0000000   0.4133176 0.5134214
ip_harm_soc    0.4939394    0.6536050 0.4133176   1.0000000 0.4100951
ip_fair        0.5395784    0.3298029 0.5134214   0.4100951 1.0000000
ip_support2    0.7910234    0.4875453 0.7334192   0.4972759 0.6335539
             ip_support2
ip_support1    0.7910234
ip_concerned   0.4875453
ip_like        0.7334192
ip_harm_soc    0.4972759
ip_fair        0.6335539
ip_support2    1.0000000
covfin$ipendorse <- apply(ipcov,1,mean,na.rm=TRUE)

p <- ggplot(covfin, aes(Worldview, ipendorse)) +
  geom_point(size=1.5,shape = 21,fill="red",
             position=position_jitter(width=0.15, height=0.15)) +
  geom_smooth() +
  theme(plot.title = element_text(size = 18),
        panel.background = element_rect(fill = "white", colour = "grey50"),
        text = element_text(size=14)) +
  xlim(0.8,7.2) + ylim(0.8,5.2) +
  labs(x="Worldview (libertarianism)", y="Endorsement of immunity passports")
print(p)

Version Author Date
639c02b Lorenz-Spreen 2020-04-26
pcor <- cor.test (covfin$Worldview,covfin$ipendorse, use="pairwise.complete.obs") %>% print()

    Pearson's product-moment correlation

data:  covfin$Worldview and covfin$ipendorse
t = -0.22897, df = 1100, p-value = 0.8189
alternative hypothesis: true correlation is not equal to 0
95 percent confidence interval:
 -0.06592990  0.05217095
sample estimates:
         cor 
-0.006903551 
p <- ggplot(covfin, aes(govtrust, ipendorse)) +
  geom_point(size=1.5,shape = 21,fill="red",
             position=position_jitter(width=0.15, height=0.15)) +
  geom_smooth() +
  theme(plot.title = element_text(size = 18),
        panel.background = element_rect(fill = "white", colour = "grey50"),
        text = element_text(size=14)) +
  xlim(0.8,7.2) + ylim(0.8,5.2) +
  labs(x="Trust in government", y="Endorsement of immunity passports")
print(p)

Version Author Date
639c02b Lorenz-Spreen 2020-04-26
pcor <- cor.test (covfin$govtrust,covfin$ipendorse, use="pairwise.complete.obs") %>% print()

    Pearson's product-moment correlation

data:  covfin$govtrust and covfin$ipendorse
t = 15.266, df = 1103, p-value < 2.2e-16
alternative hypothesis: true correlation is not equal to 0
95 percent confidence interval:
 0.3677342 0.4651658
sample estimates:
      cor 
0.4176499 
p <- ggplot(covfin, aes(COVIDrisk,ipendorse)) +
  geom_point(size=1.5,shape = 21,fill="red",
             position=position_jitter(width=0.15, height=0.15)) +
  geom_smooth() +
  theme(plot.title = element_text(size = 18),
        panel.background = element_rect(fill = "white", colour = "grey50"),
        text = element_text(size=14)) +
  xlim(0.8,7.2) + ylim(0.8,5.2) +
  labs(y="Endorsement of immunity passports", x="Perceived COVID risk")
print(p)

Version Author Date
639c02b Lorenz-Spreen 2020-04-26
pcor <- cor.test (covfin$ipendorse,covfin$COVIDrisk, use="pairwise.complete.obs") %>% print()

    Pearson's product-moment correlation

data:  covfin$ipendorse and covfin$COVIDrisk
t = 6.1181, df = 1103, p-value = 1.313e-09
alternative hypothesis: true correlation is not equal to 0
95 percent confidence interval:
 0.1235144 0.2376022
sample estimates:
      cor 
0.1811677 


sessionInfo()
R version 3.6.3 (2020-02-29)
Platform: x86_64-apple-darwin15.6.0 (64-bit)
Running under: macOS Mojave 10.14.6

Matrix products: default
BLAS:   /Library/Frameworks/R.framework/Versions/3.6/Resources/lib/libRblas.0.dylib
LAPACK: /Library/Frameworks/R.framework/Versions/3.6/Resources/lib/libRlapack.dylib

locale:
[1] en_US.UTF-8/en_US.UTF-8/en_US.UTF-8/C/en_US.UTF-8/en_US.UTF-8

attached base packages:
[1] stats     graphics  grDevices utils     datasets  methods   base     

other attached packages:
 [1] broom.mixed_0.2.4  kableExtra_1.1.0   jtools_2.0.3      
 [4] expss_0.10.2       vioplot_0.3.4      zoo_1.8-6         
 [7] sm_2.2-5.6         readxl_1.3.1       workflowr_1.6.1   
[10] summarytools_0.9.6 scales_1.0.0       psych_1.9.12.31   
[13] reshape2_1.4.3     Hmisc_4.4-0        Formula_1.2-3     
[16] survival_3.1-8     gridExtra_2.3      lme4_1.1-21       
[19] Matrix_1.2-18      forcats_0.4.0      stringr_1.4.0     
[22] purrr_0.3.2        readr_1.3.1        tidyr_1.0.0       
[25] tibble_2.1.3       ggplot2_3.2.0      tidyverse_1.2.1   
[28] tidyselect_1.0.0   stargazer_5.2.2    hexbin_1.27.3     
[31] lattice_0.20-38    dplyr_0.8.5        magrittr_1.5      
[34] knitr_1.23        

loaded via a namespace (and not attached):
 [1] minqa_1.2.4         colorspace_1.4-1    pryr_0.1.4         
 [4] ellipsis_0.2.0.1    rprojroot_1.3-2     htmlTable_1.13.3   
 [7] base64enc_0.1-3     fs_1.3.1            rstudioapi_0.10    
[10] lubridate_1.7.4     xml2_1.2.0          codetools_0.2-16   
[13] splines_3.6.3       mnormt_1.5-6        jsonlite_1.6       
[16] nloptr_1.2.1        broom_0.5.2         cluster_2.1.0      
[19] compiler_3.6.3      httr_1.4.0          backports_1.1.4    
[22] assertthat_0.2.1    lazyeval_0.2.2      cli_1.1.0          
[25] later_0.8.0         acepack_1.4.1       htmltools_0.3.6    
[28] tools_3.6.3         coda_0.19-3         gtable_0.3.0       
[31] glue_1.3.1          Rcpp_1.0.1          cellranger_1.1.0   
[34] vctrs_0.2.4         nlme_3.1-144        xfun_0.8           
[37] rvest_0.3.4         lifecycle_0.1.0     MASS_7.3-51.5      
[40] hms_0.5.0           promises_1.0.1      parallel_3.6.3     
[43] TMB_1.7.16          RColorBrewer_1.1-2  yaml_2.2.0         
[46] pander_0.6.3        rpart_4.1-15        latticeExtra_0.6-28
[49] stringi_1.4.3       checkmate_1.9.4     boot_1.3-24        
[52] rlang_0.4.5         pkgconfig_2.0.2     matrixStats_0.55.0 
[55] evaluate_0.14       labeling_0.3        rapportools_1.0    
[58] htmlwidgets_1.3     plyr_1.8.4          R6_2.4.0           
[61] magick_2.3          generics_0.0.2      mgcv_1.8-31        
[64] pillar_1.4.2        haven_2.1.1         whisker_0.3-2      
[67] foreign_0.8-75      withr_2.1.2         nnet_7.3-12        
[70] modelr_0.1.4        crayon_1.3.4        rmarkdown_1.13     
[73] grid_3.6.3          data.table_1.12.8   git2r_0.26.1       
[76] digest_0.6.20       webshot_0.5.1       httpuv_1.5.1       
[79] munsell_0.5.0       viridisLite_0.3.0   tcltk_3.6.3